                        {VERSION 14 MAR 1979}
PROGRAM MODEM;

CONST   WORD    = 31;           {8 BITS, NO PARITY, 2 STOP BITS}

        DATA    = 128;          {MODEM DATA PORT}
        STAT    = 129;          {MODEM STATUS PORT}
        MODE    = 130;          {MODEM CONTROL PORT}
        
        FOREVER = FALSE;
        SCREENWIDTH=64;         {DISPLAY SCREEN WIDTH IN CHAR}
        CLRSCR  = 26;           {CLEAR SCREEN CODE (ADM-3)}
        
        ANMESS  = 'PASCAL 80/103 MODEM SPEAKING';
        DELAYCON= 75;          {TIMING DELAY CONST
                                 Z-80 = 150, 8080 = 75}


TYPE    INSET   = SET OF 0..7;
        ATYPE   = RECORD
                    CASE BOOLEAN OF
                      TRUE: (CHAREP:CHAR);
                      FALSE:(SETREP:INSET)
                    END;
      PACKEDNUM = RECORD
                    CASE BOOLEAN OF
                      TRUE: (INT:INTEGER);
                      FALSE:(CH:PACKED ARRAY[0..1] OF CHAR)
                    END;
     PACKEDBYTE = RECORD
                    CASE BOOLEAN OF
                      TRUE: (CH:CHAR);
                      FALSE:(PNUM:PACKED ARRAY[0..1] OF 0..15)
                    END;


VAR   MODEBYTE: ATYPE;
      INBYTE:   ATYPE;
      IBYTE:    ATYPE;
      INB:      ATYPE;
      DBYTE:    ATYPE;
      CBYTE:    ATYPE;
      CSET:     ATYPE;
      TXE,TXOFF:INSET;
      RRF,TRE:  INSET;
      BRS:      INSET;
      NOTBRS:   INSET;
      ORGANS:   INSET;
      OFFMASK:  INSET;
      ONMASK:   INSET;
      MS,NOTMS: INSET;
      CARDET:   INSET;
      RNGDET:   INSET;
      MASK:     INSET;
      BK:       INSET;
      CRC:      PACKEDNUM;
      C:        PACKED ARRAY[0..1] OF CHAR;
      SHORTBUF: PACKED ARRAY[0..4] OF CHAR;
      IOBUF:    PACKED ARRAY[0..519] OF CHAR;
      FILEBUF:  PACKED ARRAY[0..511] OF CHAR;
      SOH:      CHAR;
      STX:      CHAR;
      EOT:      CHAR;
      ETX:      CHAR;
      ACK:      CHAR;
      NAK:      CHAR;
      MWORD:    CHAR;
      CONTRLB:  CHAR;
      CONTRLC:  CHAR;
      CONTRLD:  CHAR;
      CONTRLE:  CHAR;
      CONTRLH:  CHAR;
      BELL:     CHAR;
      CR,LF:    CHAR;
      NULL:     CHAR;
      EOTFLG:   BOOLEAN;
      EFLAG:    BOOLEAN;
      HEX:      BOOLEAN;
      BLK:      BOOLEAN;
      CPM:      BOOLEAN;
      HISPEED:  BOOLEAN;
      CALLMADE: BOOLEAN;
      AUTOLF:   BOOLEAN;
      FIRSTBLK: BOOLEAN;
      EXITFLG:  BOOLEAN;
      RECFLG:   BOOLEAN;
      CONECHO:  BOOLEAN;
      MESSAGE:  STRING[30];
      PHONENUM: STRING[20];
      S:        STRING[1];
      FUNCT:    STRING[64];
      NAME:     STRING;
      BLKSIZE:  INTEGER;
      BLKINDX:  INTEGER;
      BLKNUM:   INTEGER;
      DISPINDX: INTEGER;
      TIMER:    INTEGER;
      NAKCNT:   INTEGER;
      I:        INTEGER;
      RBINDX:   0..512;
      UBLKNUM:  INTEGER;
      TEXTFILE: TEXT;
      UTEXTFILE:FILE;
      
      
      

FUNCTION READY:BOOLEAN; EXTERNAL;

FUNCTION INPUT(PORT:INTEGER):CHAR; EXTERNAL;

PROCEDURE OUTPUT(PORT:INTEGER;DATA:CHAR); EXTERNAL;

FUNCTION CRC16(CRC0,CRC1,NEXTBYTE:CHAR):INTEGER; EXTERNAL;


PROCEDURE INITIALIZE;
BEGIN
  SOH:=CHR(1);                  {ASCII CONTROL CODES}
  STX:=CHR(2);
  ETX:=CHR(3);
  EOT:=CHR(4);
  ACK:=CHR(6);
  NAK:=CHR(21);
  TXE:=[1];                     {02H    TRANSMIT ENABLE}
  TXOFF:=[0,2,3,4,5,6,7];       {0FDH   TRANSMIT DISABLE}
  RRF:=[0];                     {01H    RECEIVE REGISTER FILLED}
  BRS:=[0];                     {01H    BIT RATE SELECT}
  TRE:=[1];                     {02H    TRANSMIT REGISTER EMPTY}
  MS:=[2];                      {04H    MODE SELECT (1=ORIG 0=ANSW)}
  CARDET:=[6];                  {40H    CARRIER DETECT}
  RNGDET:=[7];                  {80H    RING DETECT}
  OFFMASK:=[7];                 {80H}
  ONMASK:=[0,1,2,3,4,5,6];      {7FH}
  NOTBRS:=[1,2,3,4,5,6,7];      {0FEH   NOT BRS}
  NOTMS:=[0,1,3,4,5,6,7];       {0FBH   NOT MS)
  ORGANS:=[2];                  {04H    ORIGINATE/ANSWER BIT}
  BK:=[3];                      {08H    BREAK BIT)
  NULL:=CHR(0);                 {00H}
  CONTRLB:=CHR(2);              {02H}
  CONTRLC:=CHR(3);              {03H}
  CONTRLD:=CHR(4);              {04H}
  CONTRLE:=CHR(5);              {05H}
  CONTRLH:=CHR(8);              {08H}
  BELL:=CHR(7);                 {07H}
  CR:=CHR(13);                  {13H}
  LF:=CHR(10);                  {10H}
  MWORD:=CHR(WORD);
  EOTFLG:=FALSE;
  MODEBYTE.SETREP:=BRS;         {01H    INITIALIZE TO 300 BAUD}
  HISPEED:=TRUE;
  CPM:=FALSE;
  BLK:=FALSE;
  AUTOLF:=FALSE;
  EXITFLG:=FALSE;
  CONECHO:=TRUE;
  S:=' ';
  OUTPUT(MODE,MODEBYTE.CHAREP);
  OUTPUT(STAT,NULL)
END;


PROCEDURE BINARY(NUMBER:INSET);
VAR I:INTEGER;
BEGIN
  FOR I:=7 DOWNTO 0 DO IF I IN NUMBER THEN WRITE('1') ELSE WRITE('0')
END;


PROCEDURE HEXOUT (C:CHAR);
TYPE        HEX = PACKED ARRAY[0..1] OF 0..15;
      ALIASTYPE = RECORD
                   CASE BOOLEAN OF
                     TRUE: (CHAREP:CHAR);
                     FALSE: (HEXREP:HEX)
                   END;
VAR  ALIAS:ALIASTYPE;
         I:0..1;
BEGIN
  ALIAS.CHAREP:=C;
  FOR I:=1 DOWNTO 0 DO
  IF ALIAS.HEXREP[I] < 10 THEN WRITE(ALIAS.HEXREP[I]) 
    ELSE WRITE(CHR(ALIAS.HEXREP[I]+55));
END;


PROCEDURE DELAY(N:INTEGER);
VAR I,J:INTEGER;
BEGIN
  FOR J:=1 TO N DO
    FOR I:=1 TO DELAYCON DO;
END;

PROCEDURE BREAK;        {SENDS 120 MS OF SPACE}
BEGIN
 WRITELN;
 WRITELN(' *** Break char received from keyboard ***');
 WITH MODEBYTE DO
  BEGIN
   SETREP:=SETREP+BK;           {08H TURNS ON BREAK BIT}
   OUTPUT(MODE,CHAREP);
   DELAY(3);                    {120 MS (OR SO) OF DELAY}
   SETREP:=SETREP-BK;           {TAKE IT OUT}
   OUTPUT(MODE,CHAREP);         {RESET}
  END; {WITH}
 END; {BREAK}

PROCEDURE OFFHOOK;
BEGIN
  MODEBYTE.SETREP:=MODEBYTE.SETREP+OFFMASK;
  OUTPUT(MODE,MODEBYTE.CHAREP)
END;


PROCEDURE ONHOOK;
BEGIN
  MODEBYTE.SETREP:=MODEBYTE.SETREP*ONMASK;
  OUTPUT(MODE,MODEBYTE.CHAREP)
END;


PROCEDURE TRANON;
BEGIN
  MODEBYTE.SETREP:=MODEBYTE.SETREP+TXE;
  OUTPUT(MODE,MODEBYTE.CHAREP)
END;


PROCEDURE TRANOFF;
BEGIN
  MODEBYTE.SETREP:=MODEBYTE.SETREP*TXOFF;
  OUTPUT(MODE,MODEBYTE.CHAREP)
END;


PROCEDURE ANCALL;
BEGIN
  IF HISPEED THEN MODEBYTE.SETREP:=MODEBYTE.SETREP+BRS ELSE
      MODEBYTE.SETREP:=MODEBYTE.SETREP*NOTBRS;
  MODEBYTE.SETREP:=MODEBYTE.SETREP*NOTMS;
  OUTPUT(MODE,MODEBYTE.CHAREP);
  OUTPUT(STAT,MWORD)
END;


PROCEDURE ORCALL;
BEGIN
  IF HISPEED THEN MODEBYTE.SETREP:=MODEBYTE.SETREP+BRS ELSE
      MODEBYTE.SETREP:=MODEBYTE.SETREP*NOTBRS;
  MODEBYTE.SETREP:=MODEBYTE.SETREP+MS;
  OUTPUT(MODE,MODEBYTE.CHAREP);
  OUTPUT(STAT,MWORD)
END;


PROCEDURE HANGUP;
BEGIN
  EOTFLG:=TRUE;
  ONHOOK;
  TRANOFF
END;


FUNCTION CHECKC:BOOLEAN;         {RETURNS TRUE IF ^C ENTERED ON KEYBOARD}
BEGIN
  IF READY THEN 
  BEGIN
    UNITREAD(2,C[0],1);
    IF C[0]=CONTRLC THEN CHECKC:=TRUE ELSE CHECKC:=FALSE
  END
END;


FUNCTION RECBYTE:CHAR;
BEGIN
  TIMER:=7500;
  REPEAT
    TIMER:=TIMER-1;
    IF(CHECKC OR (TIMER=0)) THEN
    BEGIN
      EXITFLG:=TRUE;
      EXIT(RECBYTE)
    END;
    IBYTE.CHAREP:=INPUT(STAT)
  UNTIL IBYTE.SETREP*RRF<>[];
  DBYTE.CHAREP:=INPUT(DATA);
  RECBYTE:=DBYTE.CHAREP
END;


PROCEDURE TRANSMIT(DATABYTE:CHAR);
BEGIN
  REPEAT
    CBYTE.CHAREP:=INPUT(STAT)
  UNTIL CBYTE.SETREP*TRE<>[];
  OUTPUT(DATA,DATABYTE)
END;


PROCEDURE SBLKSEND(C:CHAR);    {SEND SHORT BLOCK}
VAR  I:0..4;
BEGIN
  WRITELN;
  SHORTBUF[0]:=SOH;
  SHORTBUF[1]:=NULL;
  SHORTBUF[2]:=C;
  SHORTBUF[3]:=NULL;
  SHORTBUF[4]:=NULL;
  CRC.CH[0]:=SHORTBUF[1];
  CRC.CH[1]:=SHORTBUF[2];
  FOR I:=3 TO 4 DO CRC.INT:=CRC16(CRC.CH[0],CRC.CH[1],SHORTBUF[I]);
  SHORTBUF[3]:=CRC.CH[0];
  SHORTBUF[4]:=CRC.CH[1];
  FOR I:=0 TO 4 DO
  BEGIN
    HEXOUT(SHORTBUF[I]);
    TRANSMIT(SHORTBUF[I])
  END;
  IF C=ACK THEN WRITE(' ACK') ELSE
  IF C=NAK THEN WRITE(' NAK',BELL) ELSE
  IF C=EOT THEN WRITE(' EOT')
END;


FUNCTION SBLKREC:CHAR;          {RECEIVE SHORT BLOCK}
VAR  I:0..4;
BEGIN
  WRITELN;
  REPEAT
    SHORTBUF[0]:=RECBYTE;
    IF EXITFLG THEN EXIT(SBLKREC);
  UNTIL SHORTBUF[0]=SOH;
  FOR I:=1 TO 4 DO
  BEGIN
    SHORTBUF[I]:=RECBYTE;
    HEXOUT(SHORTBUF[I])
  END;
  CRC.CH[0]:=SHORTBUF[1];
  CRC.CH[1]:=SHORTBUF[2];
  FOR I:=3 TO 4 DO CRC.INT:=CRC16(CRC.CH[0],CRC.CH[1],SHORTBUF[I]);
  IF CRC.INT<>0 THEN
  BEGIN
    WRITELN('SHORT BLOCK CRC ERROR - NAK',BELL);
    SBLKREC:=NAK
  END ELSE
  BEGIN
    SBLKREC:=SHORTBUF[2];
    IF SHORTBUF[2]=ACK THEN WRITE(' ACK') ELSE WRITE(' NAK',BELL)
  END
END;


PROCEDURE DISPHEX(DISPCHAR:CHAR);
BEGIN
  IF DISPINDX<=SCREENWIDTH THEN HEXOUT(DISPCHAR) ELSE
  BEGIN
    DISPINDX:=1;
    WRITELN;
    HEXOUT(DISPCHAR)
  END;
  DISPINDX:=DISPINDX+2
END;


PROCEDURE BLKTRANS(DATABYTE:CHAR);
VAR    I:INTEGER;
       C:CHAR;
     LEN:PACKEDNUM;
  SEQTYP:PACKEDBYTE;
BEGIN
  IF BLKINDX>BLKSIZE THEN
  BEGIN
    REPEAT
      WRITELN;WRITELN;
      DISPINDX:=1;
      BLKINDX:=1;
      WRITELN('BLOCK ',BLKNUM,'   BYTES ',(BLKNUM)*BLKSIZE);
      IOBUF[0]:=SOH;
      SEQTYP.PNUM[1]:=BLKNUM MOD 16;
      SEQTYP.PNUM[0]:=1;
      IOBUF[1]:=SEQTYP.CH;
      LEN.INT:=BLKSIZE;
      IOBUF[2]:=LEN.CH[1];
      IOBUF[3]:=LEN.CH[0];
      IOBUF[4]:=STX;
      IOBUF[BLKSIZE+5]:=ETX;
      IOBUF[BLKSIZE+6]:=NULL;
      IOBUF[BLKSIZE+7]:=NULL;
      CRC.CH[0]:=IOBUF[BLKSIZE+6];
      CRC.CH[1]:=IOBUF[BLKSIZE+7];
      FOR I:=1 TO BLKSIZE+7 DO CRC.INT:=CRC16(CRC.CH[0],CRC.CH[1],IOBUF[I]);
      IOBUF[BLKSIZE+6]:=CRC.CH[0];
      IOBUF[BLKSIZE+7]:=CRC.CH[1];
      FOR I:=0 TO BLKSIZE+7 DO
      BEGIN
        DISPHEX(IOBUF[I]);
        TRANSMIT(IOBUF[I])
      END
    UNTIL ((SBLKREC=ACK) OR EXITFLG);
    IF EXITFLG THEN EXIT(BLKTRANS);
    BLKNUM:=BLKNUM+1
  END;
  IOBUF[BLKINDX+4]:=DATABYTE;
  BLKINDX:=BLKINDX+1
END;


PROCEDURE ANSBACK;
VAR I:INTEGER;
BEGIN
  MESSAGE:=ANMESS;
  FOR I:=1 TO LENGTH(MESSAGE) DO TRANSMIT(MESSAGE[I]);
  TRANSMIT(CR);TRANSMIT(LF)
END;



PROCEDURE ANSWCALL;
VAR   I:INTEGER;
   CARR:BOOLEAN;
BEGIN
  ANCALL;
  OFFHOOK;
  TRANON;
  CALLMADE:=FALSE;
  WRITELN;
  WRITELN('PHONE ANSWERED');
  OUTPUT(MODE,MODEBYTE.CHAREP);
  I:=0;
  CARR:=FALSE;
  REPEAT
    I:=I+1;
    DELAY(10);
    INBYTE.CHAREP:=INPUT(STAT);
    INB.CHAREP:=INPUT(255);
    IF((INBYTE.SETREP*CARDET<>[]) OR (INB.SETREP*CARDET<>[])) THEN 
      BEGIN
        CARR:=TRUE;
        CALLMADE:=TRUE
      END;
  UNTIL ((I=20) OR CARR);
  WRITELN;WRITELN;
  IF CARR THEN
  BEGIN
   ANSBACK;
   WRITELN('CALL COMPLETE',BELL)
   END ELSE
  BEGIN
    WRITELN;
    WRITELN(BELL,'NO CARRIER DETECTED IN 10 SECONDS ');
    HANGUP;
    WRITELn;
    WRITE('WAITING FOR RING OR CONTROL B ')
  END
END;


PROCEDURE PULSE(N:INTEGER);
VAR I,J:INTEGER;
BEGIN
  IF N=0 THEN I:=10 ELSE I:=N;
  FOR I:=I DOWNTO 1 DO 
  BEGIN
    ONHOOK;
    DELAY(1);
    OFFHOOK;
    DELAY(1)
  END;
  DELAY(10)
END;


PROCEDURE MAKECALL;
VAR  I,J:INTEGER;
    ANSW:BOOLEAN;
BEGIN
  ONHOOK;
  TRANOFF;
  ORCALL;
  WRITELN;
  WRITE('INPUT TELEPHONE NUMBER ');
  READLN(PHONENUM);
  WRITELN;
  WRITE('DIALING...');
  OFFHOOK;
  DELAY(40);                    {WAIT FOR DIAL TONE}
  FOR I:=1 TO LENGTH(PHONENUM) DO
    BEGIN
      WRITE(PHONENUM[I]);
      J:=ORD(PHONENUM[I])-48;
      IF (PHONENUM[I] IN ['0'..'9']) THEN PULSE(J)
    END;
  I:=0;
  ANSW:=FALSE;
  CALLMADE:=FALSE;
  REPEAT
    I:=I+1;
    DELAY(10);
    INBYTE.CHAREP:=INPUT(STAT);
    INB.CHAREP:=INPUT(255);
    IF((INBYTE.SETREP*CARDET<>[]) OR (INB.SETREP*CARDET<>[])) THEN ANSW:=TRUE
  UNTIL ((I=50) OR ANSW);
  IF ANSW THEN
  BEGIN
    CALLMADE:=TRUE;
    WRITELN;
    WRITELN('CALL COMPLETE',BELL)
  END ELSE
    BEGIN
      WRITELN;
      WRITELN('SORRY, NO ANSWER');
      WRITELN;
      WRITE('WAITING FOR RING OR CONTROL B ')
    END
END;


PROCEDURE CONNECT;
BEGIN
  MODEBYTE.SETREP:=MODEBYTE.SETREP+TXE;
  OUTPUT(MODE,MODEBYTE.CHAREP);
  IF MODEBYTE.SETREP+ORGANS=[] THEN ANSBACK
END;


PROCEDURE QUIT;
BEGIN
  HANGUP;
  EXIT(PROGRAM)
END;
         

PROCEDURE GETCHAR;              {GET CHARACTER FROM MODEM}
BEGIN
  DBYTE.CHAREP:=INPUT(DATA);
  DBYTE.SETREP:=DBYTE.SETREP*ONMASK;
  IF DBYTE.CHAREP<>LF THEN WRITE(DBYTE.CHAREP);
  IF DBYTE.CHAREP=CONTRLD THEN EOTFLG:=TRUE
END;


FUNCTION CONVERT(VAR NAME:STRING):INTEGER;
VAR I,N:INTEGER;
      S:STRING;
BEGIN
  S:=NAME;
  N:=0;
  FOR I:=1 TO LENGTH(NAME) DO
  BEGIN
    IF NOT (NAME[I] IN ['0'..'9']) THEN
    BEGIN
      CONVERT:=-1;
      WRITELN('ERROR, NON NUMERIC CHARACTER IN NUMBER',BELL);
      EXIT(CONVERT)
    END;
    N:=N*10+ORD(NAME[I])-48;
  END;
  CONVERT:=N
END;


FUNCTION NEXTSTR(I:INTEGER):BOOLEAN;
VAR  B,E,J:INTEGER;
BEGIN
  E:=LENGTH(FUNCT);
  WHILE FUNCT[I]<>' ' DO I:=I+1;
  WHILE ((FUNCT[I]=' ') AND (I<E)) DO I:=I+1;
  IF I=E THEN
  BEGIN
    NEXTSTR:=FALSE;
    EXIT(NEXTSTR)
  END;
  B:=I;
  WHILE FUNCT[I]<>' ' DO I:=I+1;
  NAME:=COPY(FUNCT,B,I-B);
  NEXTSTR:=TRUE
END;


PROCEDURE BLOCK;
BEGIN
  I:=POS('BLOC',FUNCT);
  BLKSIZE:=128;
  BLK:=TRUE;
  BLKINDX:=1;
  BLKNUM:=0;
  RBINDX:=512;
  UBLKNUM:=0;
  IF NEXTSTR(I) THEN
  BEGIN
    BLKSIZE:=CONVERT(NAME);
    IF BLKSIZE=0 THEN BLK:=FALSE;
    IF BLKSIZE<0 THEN
    BEGIN
      BLKSIZE:=128;
      EXIT(BLOCK)
    END ELSE
    IF BLKSIZE>512 THEN
    BEGIN
      BLKSIZE:=512;
      WRITELN('ERROR, MAXIMUM BLOCK SIZE ALLOWED IS 512 BYTES',BELL)
    END
  END ELSE WRITELN('MISSING BLOCK SIZE VALUE')
END;


PROCEDURE SPEED;
VAR  NUM:INTEGER;
       I:INTEGER;
BEGIN
  I:=POS('SPEED',FUNCT);
  HISPEED:=TRUE;
  IF NEXTSTR(I) THEN
  BEGIN
    IF NAME='300' THEN HISPEED:=TRUE ELSE
    IF NAME='110' THEN HISPEED:=FALSE ELSE
      WRITELN('ERROR, SPEED MUST BE 110 OR 300 BAUD')
  END ELSE WRITELN('MISSING SPEED VALUE, DEFAULT TO 300 BAUD');
  IF HISPEED THEN MODEBYTE.SETREP:=MODEBYTE.SETREP+BRS ELSE
      MODEBYTE.SETREP:=MODEBYTE.SETREP*NOTBRS;
  OUTPUT(MODE,MODEBYTE.CHAREP)
END;


FUNCTION READBLKCH:CHAR;        {RETURN NEXT CHAR IN DISK FILE}
VAR  I:INTEGER;
BEGIN
  IF RBINDX>511 THEN
  BEGIN
    WRITELN;
    I:=BLOCKREAD(UTEXTFILE,FILEBUF,1);
    WRITELN;
    UBLKNUM:=UBLKNUM+1;
    RBINDX:=0
  END;
  READBLKCH:=FILEBUF[RBINDX];
  RBINDX:=RBINDX+1
END;


PROCEDURE WRITEBLK;              {WRITE A BLOCK OF CHAR TO DISK FILE}
VAR  I,J:INTEGER;
BEGIN
  FOR J:=5 TO BLKSIZE+4 DO
  BEGIN
    IF RBINDX>511 THEN
    BEGIN
      WRITELN;
      I:=BLOCKWRITE(UTEXTFILE,FILEBUF,1);
      RBINDX:=0
    END;
    FILEBUF[RBINDX]:=IOBUF[J];
    RBINDX:=RBINDX+1
  END
END;


PROCEDURE FLUSHBUFFER;          {EMPTY DISK WRITE BUFFER TO DISK}
VAR  I:INTEGER;
BEGIN
  FOR I:=RBINDX TO 511 DO FILEBUF[I]:=NULL;
  I:=BLOCKWRITE(UTEXTFILE,FILEBUF,1)
END;


PROCEDURE TEST;
BEGIN
  RBINDX:=1;
  BLKSIZE:=512;
  REWRITE(UTEXTFILE,'TEST.TEXT');
  FOR I:=0 TO 511 DO IOBUF[I]:='A';
  WRITEBLK;
  WRITEBLK;
  FLUSHBUFFER;
  CLOSE(UTEXTFILE,LOCK)
END;



FUNCTION RECEIVEBLK:CHAR;          {RECEIVE BLOCK RETURN SEQ/TYP}
VAR  I:INTEGER;
   LEN:PACKEDNUM;
BEGIN
  NAKCNT:=0;
  REPEAT
    REPEAT
      IOBUF[0]:=RECBYTE;
      IF EXITFLG THEN
      BEGIN
        WRITELN;
        WRITELN('RECEIVE TIME OUT, NAK SENT',BELL);
        SBLKSEND(NAK);
        NAKCNT:=NAKCNT+1;
        IF NAKCNT=4 THEN EXIT(RECEIVEBLK) ELSE EXITFLG:=FALSE
      END
    UNTIL IOBUF[0]=SOH;
    DISPHEX(IOBUF[0]);
    FOR I:=1 TO 4 DO
    BEGIN
      IOBUF[I]:=RECBYTE;
      DISPHEX(IOBUF[I])
    END;
    CRC.CH[0]:=IOBUF[1];
    CRC.CH[1]:=IOBUF[2];
    IF IOBUF[1]=NULL THEN
    BEGIN
      FOR I:=3 TO 4 DO CRC.INT:=CRC16(CRC.CH[0],CRC.CH[1],IOBUF[I]);
      IF CRC.INT<>0 THEN
      BEGIN
        WRITELN('RECEIVE BLOCK CRC ERROR');
        EXIT(PROGRAM)
      END ELSE RECEIVEBLK:=IOBUF[2]
    END ELSE
    BEGIN
      IF FIRSTBLK THEN
      BEGIN
        LEN.CH[1]:=IOBUF[2];
        LEN.CH[0]:=IOBUF[3];
        BLKSIZE:=LEN.INT;
        FIRSTBLK:=FALSE
      END;
      FOR I:=5 TO BLKSIZE+7 DO
      BEGIN
        IOBUF[I]:=RECBYTE;
        DISPHEX(IOBUF[I])
      END;
      FOR I:=3 TO BLKSIZE+7 DO CRC.INT:=CRC16(CRC.CH[0],CRC.CH[1],IOBUF[I])
    END;
    DISPINDX:=1;
    IF CRC.INT<>0 THEN SBLKSEND(NAK)
  UNTIL CRC.INT=0;
  WRITEBLK;
  WRITELN;
  WRITELN('BLOCK ',BLKNUM,'   BYTES ',BLKSIZE*BLKNUM);
  WRITELN;
  BLKNUM:=BLKNUM+1;
  IF IOBUF[1]<>NULL THEN SBLKSEND(ACK) ELSE
  IF IOBUF[2]=EOT THEN SBLKSEND(EOT)
END;


PROCEDURE RECEIVE;
VAR  I:INTEGER;
   ERR:INTEGER;
    CH:CHAR;
BEGIN
  I:=POS('RECEIVE',FUNCT);
  IF NEXTSTR(I) THEN
  BEGIN
    RECFLG:=TRUE;
    DISPINDX:=1;
    RBINDX:=0;
    BLKNUM:=0;
    IF POS('HEX',FUNCT)<>0 THEN HEX:=TRUE ELSE HEX:=FALSE;
    I:=0;
    {$I-}
    RESET(UTEXTFILE,NAME);
    {$I+}
    ERR:=IORESULT;
    IF ERR=10 THEN REWRITE(UTEXTFILE,NAME) ELSE
    IF ERR=0 THEN
    BEGIN
      WRITE(NAME,' ALREADY EXISTS, DO YOU WANT TO OVERWRITE IT (Y/N) ');
      READ(CH);
      IF CH<>'Y' THEN EXIT(RECEIVE) ELSE REWRITE(UTEXTFILE,NAME)
    END ELSE
    BEGIN
      WRITELN('ERROR IN OPENING FILE ',NAME);
      EXIT(RECEIVE)
    END;
    FIRSTBLK:=TRUE;
    DBYTE.CHAREP:=INPUT(DATA);          {CLEAR MODEM INPUT}
    WHILE ((RECEIVEBLK<>EOT) AND NOT EXITFLG) DO WRITEBLK;
    FLUSHBUFFER;
    IF NOT EXITFLG THEN CLOSE(UTEXTFILE,LOCK) ELSE CLOSE(UTEXTFILE);
    IF TIMER=0 THEN
    BEGIN
      WRITELN;WRITELN;
      WRITE('RECEIVE TERMINATED NO MESSAGE',BELL)
    END;
    EXITFLG:=FALSE
  END ELSE
  BEGIN
    WRITELN;
    WRITE('MISSING FILE NAME')
  END
END;
       
       

PROCEDURE SEND;
VAR  I:INTEGER;
   ERR:INTEGER;
    CH:CHAR;
BEGIN
  RECFLG:=FALSE;
  I:=POS('SEND',FUNCT);
  IF NEXTSTR(I) THEN
  BEGIN
    IF POS('HEX',FUNCT)<>0 THEN HEX:=TRUE ELSE HEX:=FALSE;
    I:=0;
    {$I-}
    IF BLK THEN RESET(UTEXTFILE,NAME) ELSE RESET(TEXTFILE,NAME);
    {$I+}
    ERR:=IORESULT;
    IF ERR<>0 THEN WRITELN('ERROR IN OPENING FILE') ELSE
       IF BLK THEN
       BEGIN
         WHILE NOT EOF(UTEXTFILE) DO
         BEGIN
           CH:=READBLKCH;
           BLKTRANS(CH);
           IF EXITFLG THEN
           BEGIN
             CLOSE(UTEXTFILE);
             BLK:=FALSE;
             EXITFLG:=FALSE;
             IF TIMER=0 THEN
             BEGIN
               WRITELN;
               WRITELN('TRANSMIT TIME-OUT NO ACKNOWLEDGEMENT',BELL);
             END;
             EXIT(SEND)
           END
         END;
         CLOSE(UTEXTFILE);
         BLK:=FALSE;
         SBLKSEND(EOT)
       END ELSE
       WHILE NOT EOF(TEXTFILE) DO
        BEGIN
          IF CHECKC THEN
          BEGIN
            CLOSE(TEXTFILE);
            EXIT(SEND)
          END ELSE
          BEGIN
            READ(TEXTFILE,CH);
            TRANSMIT(CH);
            IF HEX THEN
            BEGIN
              HEXOUT(CH);
              I:=I+2;
              IF I> SCREENWIDTH THEN 
              BEGIN
                I:=0;
                WRITELN
              END
            END ELSE 
            BEGIN
              WRITE(CH);
              IF EOLN(TEXTFILE) THEN WRITELN
            END;
            IF EOLN(TEXTFILE) THEN 
            BEGIN
              TRANSMIT(CR);
              IF CPM THEN TRANSMIT(LF)
            END
          END
        END;
    CLOSE(TEXTFILE)
  END ELSE
  BEGIN
    WRITELN;
    WRITE('MISSING FILE SPECIFICATION',BELL)
  END
END;


PROCEDURE STATUS;               {DISPLAY CURRENT STATUS}
BEGIN
  WRITE(CHR(CLRSCR));
  WRITELN;WRITELN;
  WRITE('CURRENT MODEM STATUS':45);
  WRITELN;WRITELN;WRITELN;
  WRITE('PHONE           ');
  IF MODEBYTE.SETREP*[7]<>[] THEN WRITELN('OFFHOOK') ELSE WRITELN('ONHOOK');
  WRITE('MODE            ');
  IF MODEBYTE.SETREP*[2]<>[] THEN WRITELN('ORIGINATE') ELSE
       WRITELN('ANSWER');
  WRITE('BAUD RATE       ');
  IF MODEBYTE.SETREP*[0]<>[] THEN WRITELN('110 BAUD') ELSE WRITELN('300 BAUD');
  WRITE('TRANSMITTER     ');
  IF MODEBYTE.SETREP*[1]<>[] THEN WRITELN('ON') ELSE WRITELN('OFF');
  WRITE('CARRIER         ');
  CBYTE.CHAREP:=INPUT(STAT);
  IF CBYTE.SETREP*[6]<>[] THEN WRITELN('ON') ELSE WRITELN('OFF');
END;

PROCEDURE CONVERSE;
 BEGIN
  EFLAG:=FALSE;
  EOTFLG:=FALSE;
  CONNECT;
  REPEAT
    INBYTE.CHAREP:=INPUT(STAT);
    INB.CHAREP:=INPUT(255);M    IF((INBYTE.SETREP*CARDET<>[]) OR (INB.SETREP*CARDET<>[])) THEN
    BEGIN
      IBYTE.CHAREP:=INPUT(STAT);
      IF IBYTE.SETREP*RRF<>[] THEN GETCHAR;
      IF READY THEN
      BEGIN
        UNITREAD(2,C[0],1);
        IF C[0]=NAK THEN BREAK;
        IF CONECHO THEN WRITE(C[0]);
        IF((C[0]=CR) AND AUTOLF) THEN TRANSMIT(LF);
        IF C[0]=CONTRLE THEN EFLAG:=TRUE;
        IF C[0]=CONTRLH THEN
        BEGIN
          WRITE(' ',CONTRLH);
          TRANSMIT(CONTRLH);
          TRANSMIT(' ')
        END;
        IF C[0]=CONTRLD THEN
          BEGIN
            EOTFLG:=TRUE;
            WRITELN;
            WRITELN('EOT')
          END;
        TRANSMIT(C[0])
      END;
    END ELSE
    BEGIN
      WRITELN;
      WRITE('LOST CARRIER',BELL);
      EOTFLG:=TRUE
    END
  UNTIL (EOTFLG OR EFLAG);
END; {CONVERSE}

PROCEDURE RING;
BEGIN
  REPEAT
  WRITELN;WRITELN;
  WRITE('WAITING FOR RING OR CONTROL B ');
  CALLMADE:=FALSE;
  EFLAG:=FALSE;
  EOTFLG:=FALSE;
  REPEAT
    IF READY THEN
    BEGIN
      UNITREAD(2,C[0],1);
      IF C[0]=CONTRLB THEN MAKECALL;
      IF C[0]=CONTRLE THEN EXIT(RING)
    END;
    INBYTE.CHAREP:=INPUT(STAT);
    INB.CHAREP:=INPUT(255);
    IF((INBYTE.SETREP*RNGDET=[]) OR (INB.SETREP*RNGDET<>[]))
     THEN ANSWCALL
  UNTIL CALLMADE;
  CONVERSE;
  IF NOT EFLAG THEN HANGUP;
UNTIL EFLAG
END; {RING}

BEGIN {MAIN PROG}
WRITELN;WRITELN;WRITELN;
WRITELN('PASCAL MODEM PROGRAM':45);
INITIALIZE;
  REPEAT
    WRITELN;WRITELN;
    WRITE('ENTER FUNCTION ');
    UNITREAD(2,C[0],1);
    IF C[0]=CONTRLC THEN QUIT;
    WRITE(C[0]);
    READLN(FUNCT);
    S[1]:=C[0];
    FUNCT:=CONCAT(S,FUNCT,'  ');
    IF POS('CONECHO',FUNCT)<>0 THEN CONECHO:=NOT CONECHO;
    IF POS('STAT',FUNCT)<>0 THEN STATUS;
    IF POS('CPM',FUNCT)<>0 THEN CPM:=NOT CPM;
    IF POS('AUTOLF',FUNCT)<>0 THEN AUTOLF:=NOT AUTOLF;
    IF POS('SPEED',FUNCT)<>0 THEN SPEED;
    IF POS('BLOC',FUNCT)<>0 THEN BLOCK;
    IF POS('PHONE',FUNCT)<>0 THEN RING;
    IF POS('CONV',FUNCT)<>0 THEN CONVERSE;
    IF POS('SEND',FUNCT)<>0 THEN SEND;
    IF POS('RECEI',FUNCT)>0 THEN RECEIVE
  UNTIL FOREVER
END.

